;; binary.scm: Thrift binary protocol implementation for r6rs-thrift
;; Copyright (C) 2012 Julian Graham

;; r6rs-thrift is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

#!r6rs

(library (thrift protocol binary)
  (export thrift:binary-protocol)
  (import (rnrs)
	  (thrift private)
	  (thrift protocol))

  (define version-1 #x80010000)
  (define version-mask #xffff0000)

  (define (thrift:binary-write-message-begin port message)
    (let ((version (bitwise-ior version-1 
				(thrift:message-type->byte
				 (thrift:message-type-symbol message)))))
      (thrift:binary-write-i32 port version)
      (thrift:binary-write-string port (thrift:message-name message))
      (thrift:binary-write-i32 port (thrift:message-seq-id message))))

  (define (thrift:binary-write-message-end port message) (if #f #f))

  (define (thrift:binary-write-struct-begin port struct) (if #f #f))
  (define (thrift:binary-write-struct-end port struct) (if #f #f))

  (define (thrift:binary-write-field-begin port field)
    (let ((field-descriptor (thrift:field-field-descriptor field)))
      (put-u8 port (thrift:wire-type->byte
		    (thrift:field-type-descriptor-wire-type 
		     (thrift:resolve-type
		      (thrift:field-descriptor-type field-descriptor)))))
      (thrift:binary-write-i16
       port (thrift:field-descriptor-index field-descriptor))))

  (define (thrift:binary-write-field-end port field) (if #f #f))
  (define (thrift:binary-write-field-stop port)
    (put-u8 port (thrift:wire-type->byte (thrift:wire-type stop))))

  (define (thrift:binary-write-map-begin port map key-type value-type)
    (put-u8 port (thrift:wire-type->byte 
		  (thrift:field-type-descriptor-wire-type key-type)))
    (put-u8 port (thrift:wire-type->byte 
		  (thrift:field-type-descriptor-wire-type value-type)))
    (thrift:binary-write-i32 port (hashtable-size map)))

  (define (thrift:binary-write-map-end port map key-type value-type) 
    (if #f #f))

  (define (thrift:binary-write-list-begin port list type)
    (put-u8 port (thrift:wire-type->byte 
		  (thrift:field-type-descriptor-wire-type type)))
    (thrift:binary-write-i32 port (vector-length list)))

  (define (thrift:binary-write-list-end port list type) (if #f #f))
  
  (define (thrift:binary-write-set-begin port set type)
    (put-u8 port (thrift:wire-type->byte 
		  (thrift:field-type-descriptor-wire-type type)))
    (thrift:binary-write-i32 port (length set)))

  (define (thrift:binary-write-set-end port set type) (if #f #f))
  
  (define (thrift:binary-write-bool port bool)
    (thrift:binary-write-byte port (if bool 1 0)))

  (define (thrift:binary-write-byte port byte)
    (put-u8 port byte))

  (define (thrift:binary-write-i16 port i16)
    (put-u8 port (bitwise-and (bitwise-arithmetic-shift-right i16 8) #xff))
    (put-u8 port (bitwise-and i16 #xff)))

  (define (thrift:binary-write-i32 port i32)
    (let ((bv (make-bytevector 4)))
      (bytevector-u8-set!
       bv 0 (bitwise-and (bitwise-arithmetic-shift-right i32 24) #xff))
      (bytevector-u8-set!
       bv 1 (bitwise-and (bitwise-arithmetic-shift-right i32 16) #xff))
      (bytevector-u8-set!
       bv 2 (bitwise-and (bitwise-arithmetic-shift-right i32 8) #xff))
      (bytevector-u8-set! bv 3 (bitwise-and i32 #xff))
      
      (put-bytevector port bv)))

  (define (thrift:binary-write-i64 port i64)
    (let ((bv (make-bytevector 8)))
      (bytevector-u8-set!
       bv 0 (bitwise-and (bitwise-arithmetic-shift-right i64 56) #xff))
      (bytevector-u8-set!
       bv 1 (bitwise-and (bitwise-arithmetic-shift-right i64 48) #xff))
      (bytevector-u8-set!
       bv 2 (bitwise-and (bitwise-arithmetic-shift-right i64 40) #xff))
      (bytevector-u8-set! 
       bv 3 (bitwise-and (bitwise-arithmetic-shift-right i64 32) #xff))
      (bytevector-u8-set!
       bv 4 (bitwise-and (bitwise-arithmetic-shift-right i64 24) #xff))
      (bytevector-u8-set!
       bv 5 (bitwise-and (bitwise-arithmetic-shift-right i64 16) #xff))
      (bytevector-u8-set!
       bv 6 (bitwise-and (bitwise-arithmetic-shift-right i64 8) #xff))
      (bytevector-u8-set! bv 7 (bitwise-and i64 #xff))
      
      (put-bytevector port bv)))

  (define (thrift:binary-write-double port double)
    (let ((bv (make-bytevector 8)))
      (bytevector-ieee-double-set! bv 0 double (endianness big))
      (put-bytevector port bv)))

  (define (thrift:binary-write-string port string)
    (let ((bv (string->utf8 string)))
      (thrift:binary-write-i32 port (bytevector-length bv))
      (put-bytevector port bv)))

  (define (thrift:binary-read-message-begin port)
    (let ((size (thrift:binary-read-i32 port)))
      (if (< size 0)
	  (let ((version (bitwise-and size version-mask)))
	    (or (eqv? version version-1)
		(raise (make-assertion-violation)))
	    (values (thrift:binary-read-string port)
		    (thrift:byte->message-type (bitwise-and size #xff))
		    (thrift:binary-read-i32 port)))

	  (let ((bv (get-bytevector-n port size)))	    
	    (values (utf8->string bv)
		    (thrift:byte->message-type (thrift:binary-read-byte port))
		    (thrift:binary-read-i32 port))))))
   
  (define (thrift:binary-read-message-end port message) message)

  (define (thrift:binary-read-struct-begin port) (if #f #f))
  (define (thrift:binary-read-struct-end port struct) struct)

  (define (thrift:binary-read-field-begin port)
    (let ((wire-type (thrift:byte->wire-type (thrift:binary-read-byte port))))
      (values wire-type
	      (and (not (eq? wire-type (thrift:wire-type stop)))
		   (thrift:binary-read-i16 port)))))
  (define (thrift:binary-read-field-end port field) field)

  (define (thrift:binary-read-map-begin port)
    (values (thrift:byte->wire-type (thrift:binary-read-byte port))
	    (thrift:byte->wire-type (thrift:binary-read-byte port))
	    (thrift:binary-read-i32 port)))
  (define (thrift:binary-read-map-end port map) map)

  (define (thrift:binary-read-list-begin port)
    (values (thrift:byte->wire-type (thrift:binary-read-byte port))
	    (thrift:binary-read-i32 port)))
  (define (thrift:binary-read-list-end port list) list)

  (define (thrift:binary-read-set-begin port)
    (values (thrift:byte->wire-type (thrift:binary-read-byte port))
	    (thrift:binary-read-i32 port)))
  (define (thrift:binary-read-set-end port set) set)

  (define (thrift:binary-read-bool port)
    (eqv? (thrift:binary-read-byte port) 1))

  (define (thrift:binary-read-byte port) (get-u8 port))

  (define (thrift:binary-read-i16 port)
    (bytevector-s16-ref (get-bytevector-n port 2) 0 (endianness big)))
  
  (define (thrift:binary-read-i32 port)
    (bytevector-s32-ref (get-bytevector-n port 4) 0 (endianness big)))

  (define (thrift:binary-read-i64 port)
    (bytevector-s64-ref (get-bytevector-n port 8) 0 (endianness big)))

  (define (thrift:binary-read-double port)
    (let ((bv (get-bytevector-n port 8)))
      (bytevector-ieee-double-ref bv 0 (endianness big))))
  
  (define (thrift:binary-read-string port)
    (let* ((size (thrift:binary-read-i32 port))
	   (bv (get-bytevector-n port size)))
      (utf8->string bv)))

  (define thrift:binary-protocol
    (thrift:make-protocol
     (thrift:make-serializer thrift:binary-write-message-begin
			     thrift:binary-write-message-end
			     thrift:binary-write-struct-begin
			     thrift:binary-write-struct-end
			     thrift:binary-write-field-begin
			     thrift:binary-write-field-end
			     thrift:binary-write-field-stop
			     thrift:binary-write-map-begin
			     thrift:binary-write-map-end
			     thrift:binary-write-list-begin
			     thrift:binary-write-list-end
			     thrift:binary-write-set-begin
			     thrift:binary-write-set-end
			     thrift:binary-write-bool
			     thrift:binary-write-byte
			     thrift:binary-write-i16
			     thrift:binary-write-i32
			     thrift:binary-write-i64
			     thrift:binary-write-double
			     thrift:binary-write-string)

     (thrift:make-deserializer thrift:binary-read-message-begin
			       thrift:binary-read-message-end
			       thrift:binary-read-struct-begin
			       thrift:binary-read-struct-end
			       thrift:binary-read-field-begin
			       thrift:binary-read-field-end
			       thrift:binary-read-map-begin
			       thrift:binary-read-map-end
			       thrift:binary-read-list-begin
			       thrift:binary-read-list-end
			       thrift:binary-read-set-begin
			       thrift:binary-read-set-end
			       thrift:binary-read-bool
			       thrift:binary-read-byte
			       thrift:binary-read-i16
			       thrift:binary-read-i32
			       thrift:binary-read-i64
			       thrift:binary-read-double
			       thrift:binary-read-string)))
)
